home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / cnet / cnettoolkit2a.lha / CNet_ToolKit.REXX! < prev    next >
Text File  |  1994-12-16  |  62KB  |  1,443 lines
  1. ****************************************************************************
  2.    CNet ARexx Tool Kit, v2.0 by PMK & DOTORAN - For CNet v3.05c & Beyond!
  3.  
  4.           A Collection of Useful ARexx SubRoutines & Procedures!
  5.  
  6.            Please use ANY of these in your OWN ARexx Creations!
  7.  
  8.        $VER: CNet ARexx Tool Kit, v2.0 (16-Dec-94) by PMK & Dotoran!
  9. ****************************************************************************
  10.  
  11. CONTENTS:
  12.  
  13.         [01] : From "Expanded" date to "Sorted" or "Internal" date format.
  14.         [02] : From x5xxxxx GU Value to "Sorted" or "Internal" date format.
  15.         [03] : From "Sorted" or "Internal" date to "Expanded" date format.
  16.         [04] : "Signed" Numeric Format into "UnSigned" Numeric Format.
  17.         [05] : "UnSigned" Numeric Format into "Signed" Numeric Format.
  18.         [06] : Numeric Range Parser: [ -2 19- 4 7-9 11.13.15,17 ]
  19.         [07] : CNet-like input routine, using MCI.
  20.         [08] : Find and return BBSTEXT/BBSMENU line entry.
  21.         [09] : Check if a user is Suboperator in current subboard.
  22.         [10] : Checks if MCI is enabled in current subboard.
  23.         [11] : Convert from 12/24 hour time format to 12/24/min format.
  24.         [12] : External Library Loader
  25.         [13] : View, Enable, Disable or Toggle "Priviledge" Flags.
  26.         [14] : Get "Arguments" from last command.
  27.         [15] : Read "Cursor Key" / "Return/Enter" Keyboard Input.
  28.         [16] : Convert "UPPERCASE" to "lowercase" text.
  29.         [17] : Pauses output for "x" number of seconds the RIGHT way!
  30.         [18] : Checks for "Loss of Carrier" in your Pfiles!
  31.         [19] : An informative "Error Checking" routine.
  32.         [20] : Positions cursor for printing anywhere on the screen.
  33.         [21] : Horizontal Text Scroller Number 1.
  34.         [22] : Horizontal Text Scroller Number 2.
  35.         [23] : Read the joystick(s) and firebutton(s).
  36.         [24] : First attempt at MOUSE capability. (95% Complete!)
  37.         [25] : Disable or Enable the MORE? prompt, regardless of setting!
  38.         [26] : Muffle ALL ports, regardless of setting!
  39.         [27] : Extended SelectFile Routine.
  40.         [28] : Add line of text to specified LOG file.
  41.         [29] : Check Port Menu(s) Checkmark Status.
  42.         [30] : Send Text File as CNet MAIL to specified User.
  43.         [31] : Send SystemOLM to current user.
  44.         [32] : Add keystrokes to other ports from present port.
  45.         [33] : A QUICK "Who" for SysOps, listing Access Group Number.
  46.         [34] : View "port" log of specified port. (Pre "calls" log).
  47.         [35] : Send Line Noise to a port (Ability to kick them off too!)
  48.         [36] : UnLock User Accounts (That May NOT Have Been Previously!)
  49.         [37] : Replace <input> with <output> within string of <text>.
  50.         [38] : Find and return BBSMENU section line(s).
  51.         [39] : Clears a specific port, by dumping the user.
  52.         [40] : EnCode & DeCode text strings, using a Numeric Key.
  53.  
  54. ****************************************************************************
  55.  
  56. /**[01]*********************************************************************
  57.  *
  58.  * Description: From "Expanded" date to "Sorted" or "Internal" date format.
  59.  *
  60.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  61.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  62.  *
  63.  ***************************************************************************
  64.  *
  65.  *    Expanded: Sun 25-Dec-1993 11:53a
  66.  *      Sorted: 19931225    (In YYYYMMDD Format)
  67.  *    Internal: 5837        (In Days Format)
  68.  *
  69.  *       Usage: <var>=SDATE(<date>,[mode])
  70.  *
  71.  *       Where: <date>  holds an "Expanded" Date.
  72.  *              [mode]  as 'i' returns Internal Days Format.
  73.  *                      (Number of days since January 1, 1978)
  74.  *
  75.  *     Returns: <var>   holds the sorted (or internal) date format.
  76.  *
  77.  *      Note 1: Because of the way the internal ARexx DATE() command works,
  78.  *              you should NOT use dates PREVIOUS to January 1, 1978 when
  79.  *              using the 'i' (internal) setting. This routine will, however
  80.  *              return the SORTED date for ANY DATE given.
  81.  *
  82.  *      Note 2: We decided to keep the 'i' parameter, because it's a FAST
  83.  *              way to perform MATH functions on dates(13 days ago, etc).
  84.  */
  85.  
  86. getuser 1500000 ; d1=result ; d2=SDATE(d1) ; d3=SDATE(d1,'i')
  87. transmit 'Expanded Date: 'd1
  88. transmit '  Sorted Date: 'd2
  89. transmit 'Internal Days: 'd3
  90. exit
  91.  
  92. SDATE: procedure;arg da,mo
  93.   da=substr(da,12,4)right(index('ANEBARPRAYUNULUGEPCTOVEC',substr(da,9,2))%2+1,2,'0')right(strip(substr(da,5,2)),2,'0')
  94.   if mo='I' then return date('i',da,'s')
  95.  return da
  96.  
  97. /**[02]*********************************************************************
  98.  *
  99.  * Description: From x5xxxxx GU Value to "Sorted" or "Internal" date format.
  100.  *
  101.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  102.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  103.  *
  104.  ***************************************************************************
  105.  *
  106.  *     x5xxxxx: 1500000, 1500410, 2500990, etc.
  107.  *
  108.  *      Sorted: 19930120    (In YYYYMMDD Format)
  109.  *
  110.  *    Internal: 5837        (In Days Format)
  111.  *
  112.  *       Usage: <var>=SDATE(<value>,[mode])
  113.  *
  114.  *       Where: <value> holds the 7-Digit x5xxxxx GetUser Value.
  115.  *              [mode]  as 'i' returns Internal Days Format.
  116.  *                      (Number of days since January 1, 1978)
  117.  *
  118.  *     Returns: <var>   holds the sorted (or internal) date format.
  119.  *
  120.  *      Note 1: Because of the way the internal ARexx DATE() command works,
  121.  *              you should NOT use dates PREVIOUS to January 1, 1978 when
  122.  *              using the 'i' (internal) setting. This routine will, however
  123.  *              return the SORTED date for ANY DATE given.
  124.  *
  125.  *      Note 2: We decided to keep the 'i' parameter, because it's a FAST
  126.  *              way to perform MATH functions on dates(13 days ago, etc).
  127.  */
  128.  
  129. getuser 1500416;a=result;transmit 'Expanded 1st Call Date: 'a
  130. d1=GDATE(1500416);transmit '  Sorted 1st Call Date: 'd1
  131. d2=GDATE(1500416,'i');transmit 'Internal 1st Call Date: 'd2
  132. exit
  133.  
  134. GDATE: procedure;arg da,mo;getuser da;da=result
  135.   da=substr(da,12,4)right(index('ANEBARPRAYUNULUGEPCTOVEC',substr(da,9,2))%2+1,2,'0')right(strip(substr(da,5,2)),2,'0')
  136.   if mo='I' then return date('i',da,'s')
  137.  return da
  138.  
  139. /**[03]*********************************************************************
  140.  *
  141.  * Description: From "Sorted" or "Internal" date to "Expanded" date format.
  142.  *
  143.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  144.  *
  145.  ***************************************************************************
  146.  *
  147.  *      Sorted: 19931225        (In YYYYMMDD Format)
  148.  *    Internal: 5837            (In Days Format)
  149.  *    Expanded: Sun 25-Dec-1993 (No time format!)
  150.  *
  151.  *       Usage: <var>=EDATE(<date>,[mode])
  152.  *
  153.  *       Where: <date>  holds a "Sorted" or "Internal" Date.
  154.  *              [mode]  Specified as 'i' if <date> supplied is in
  155.  *                      Internal Days Format.
  156.  *                      (Number of days since January 1, 1978)
  157.  *
  158.  *     Returns: <var>   holds the expanded date format.
  159.  *
  160.  *      Note 1: Because of the way the internal ARexx DATE() command works,
  161.  *              you should NOT use dates PREVIOUS to January 1, 1978 when
  162.  *              using the 'i' (internal) setting. This routine will, however
  163.  *              return the SORTED date for ANY DATE given.
  164.  *
  165.  *      Note 2: We decided to keep the 'i' parameter, because it's a FAST
  166.  *              way to perform MATH functions on dates(13 days ago, etc).
  167.  */
  168.  
  169. d1='19940802' ; d2=EDATE(d1) ; d3='6000' ; d4=EDATE(d3,'i')
  170.  
  171. transmit '  Sorted Date: 'd1' = Expanded Date: 'd2
  172. transmit 'Internal Days: 'd3'     = Expanded Date: 'd4
  173. exit
  174.  
  175. EDATE: procedure;arg da,mo;if mo='I' then da=date('s',da,'i')
  176.   return left(date('w',da,'s'),3)right('  'strip(translate(date('n',da,'s'),'-',' '),'L','0'),12)
  177.  
  178. /**[04]*********************************************************************
  179.  *
  180.  * Description: "Signed" Numeric Format into "UnSigned" Numeric Format.
  181.  *
  182.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  183.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  184.  *
  185.  ***************************************************************************
  186.  *
  187.  *       Usage: <var>=SIGNED(<value>,<size>)
  188.  *
  189.  *       Where: <var>    is the variable to store converted number in.
  190.  *              <value>  is the signed value to convert.
  191.  *              <size>   is the bit-size of the number(8, 16, 32)
  192.  *
  193.  *     Returns: <var>    holds the converted number.
  194.  *
  195.  *   GetUser  # of Bits       Signed Range               UnSigned Range
  196.  ***************************************************************************
  197.  *   x1xxxxx     8             -127 to 128               0 to 255
  198.  *   x2xxxxx    16          -32,767 to 32,768            0 to 65,535
  199.  *   x4xxxxx    32   -2,147,483,647 to 2,147,483,648     0 to 4,294,967,295
  200.  *
  201.  *   If using 32-bit values, include "NUMERIC DIGITS 10" somewhere at the
  202.  * start of your program, else the routine will choke on the scientific
  203.  * notation used with the standard "NUMERIC DIGITS 9" default setting.
  204.  *
  205.  *   Also, if using 32-bit values with BINARY digits(as in CNet FLAGS), be
  206.  * advised that if flag # 31 is used, INCORRECT results will be given.  You
  207.  * will have to read the value as two 16-bit values and combine them to form
  208.  * your binary string. (Examples of both are given below)
  209.  */
  210.  
  211. numeric digits 10
  212. getuser 1400648 ; a=result ; c=SIGNED(a,32)
  213. transmit "User's Message Base Flags:n1"
  214. transmit 'As one 32-Bit Value:n1'
  215. transmit '  Signed Value: 'a
  216. transmit 'UnSigned Value: 'c
  217. transmit ' Binary String: 'reverse(c2b(d2c(c,4)))
  218.  
  219. getuser 1200648 ; a1=result ; c1=SIGNED(a1,16)
  220. getuser 1200650 ; a2=result ; c2=SIGNED(a2,16)
  221. transmit 'n1As two 16-Bit Values:n1'
  222. transmit '  Signed Value: 'a
  223. transmit 'UnSigned Value: 'c
  224. transmit ' Binary String: 'reverse(c2b(d2c(c1,2))c2b(d2c(c2,2)))
  225. exit
  226.  
  227. SIGNED: ; return ARG(1)+((ARG(1)<0)*256**(ARG(2)%8))
  228.  
  229. /**[05]*********************************************************************
  230.  *
  231.  * Description: "UnSigned" Numeric Format into "Signed" Numeric Format.
  232.  *
  233.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  234.  *
  235.  ***************************************************************************
  236.  *
  237.  *       Usage: <var>=UNSIGNED(<value>,<size>)
  238.  *
  239.  *       Where: <value>  is the signed value to convert.
  240.  *              <size>   is the bit-size of the number(8, 16, 32)
  241.  *
  242.  *     Returns: <var>    holds the converted number.
  243.  *
  244.  *  GetUser  # of Bits       Signed Range               UnSigned Range
  245.  ***************************************************************************
  246.  *  x1xxxxx     8             -127 to 128               0 to 255
  247.  *  x2xxxxx    16          -32,767 to 32,768            0 to 65,535
  248.  *  x4xxxxx    32   -2,147,483,647 to 2,147,483,648     0 to 4,294,967,295
  249.  *
  250.  *   If using 32-bit values, include "NUMERIC DIGITS 10" somewhere at the
  251.  * start of your program, else the routine will choke on the scientific
  252.  * notation used with the standard "NUMERIC DIGITS 9" default setting.
  253.  *
  254.  *   This routine is handy when you CHANGE the value of a signed number. You
  255.  * have to change it to an UNSIGNED number before you can manipulate it, but
  256.  * you then have to convert it back to a SIGNED number before you can save
  257.  * the value using the PUTUSER command.
  258.  */
  259.  
  260. numeric digits 10
  261. transmit 'Sets Message Base Flags "25-31":n1'
  262. a=4261412864 ; c=UNSIGNED(a,32)
  263. transmit 'Unsigned Value: 'a
  264. transmit '  Signed Value: 'c'n1'
  265. transmit '    ARexx Code: SETOBJECT 'c' ; PUTUSER 1400648'
  266. exit
  267.  
  268. UNSIGNED:;return ARG(1)-(ARG(1)>((256**(ARG(2)%8))/2)-1)*256**(ARG(2)%8)
  269.  
  270. /**[06]*********************************************************************
  271.  *
  272.  * Description: Numeric Range Parser: [ -2 19- 4 7-9 11.13.15,17 ]
  273.  *
  274.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  275.  *              PMK             - Flux Point Amiga BBS      +45 3526-2527
  276.  *
  277.  ***************************************************************************
  278.  *
  279.  *       Usage: <var>=PARSE(<range>,<min>,<max>,[sort])
  280.  *
  281.  *       Where: <var>    is any Legal Variable Name.
  282.  *              <range>  is the Numeric Range to Parse.
  283.  *              <min>    is the Minimum Value to Use.
  284.  *              <max>    is the Maximum Value to Use.
  285.  *              [sort]   as 's' is OPTIONAL. If specified, the items will
  286.  *                       also be Numerically Sorted. Duplicate Item checking
  287.  *                       is ONLY performed on SORTED item lists.
  288.  *
  289.  *     Returns: <var>    total parsed items.
  290.  *              <it.0>   parsed item string, parsed in SPACES.
  291.  *              <it.1>
  292.  *                 |
  293.  *              <it.?>   the individual parsed item array.
  294.  *
  295.  *      Note 1: This routine functions EXACTLY like CNet's own routine.
  296.  *              Open ended ranges( -5 or 12- ) fully supported. Any use
  297.  *              of DUPLICATE item numbers are removed, and the resulting
  298.  *              it.? array contains items in NUMERICAL Order. All Non-
  299.  *              Numeric items are discarded. Use the "it.0" variable
  300.  *              string in conjunction with the INDEX() command for VERY
  301.  *              FAST verification checking!
  302.  *
  303.  *      Note 2: If sorting is NOT essential to your needs in a particular
  304.  *              application, we suggest NOT using it, as it will speed up
  305.  *              the parsing process CONSIDERABLY! (VERY, VERY QUICK!)
  306.  */
  307.  
  308. transmit '>4Minimum: 0n1>4Maximum: 25n1>7Sort: ONn1'
  309. transmit ' An Example: -2 19- 4 7-9 11.13.15,17n1'
  310. query 'Enter Range: ' ; tot=PARSE(result,0,25,'s')
  311. transmit 'n1 ARexx Code: result="'result'"'
  312. transmit "Ctot=PARSE(result,0,25,'s')n1"
  313. transmit 'Total Items: 'tot ; transmit 'Parsed Data: 'it.0
  314. do i=1 to tot ; transmit '  Item # 'right(i,2)': 'it.i ; end i
  315. exit
  316.  
  317. PARSE: procedure expose it.; arg rng,min,max,srt
  318.    it.='';c=0;it=translate(rng,'  ','.,')
  319.     do a=1 to words(it);c=c+1;it.c=word(it,a)
  320.         if index(it.c,'-')>0 then do;parse var it.c x'-'y
  321.         if y='' then y=max;if x='' then x=min
  322.         if x>y then do;d=x;x=y;y=d;end
  323.         if x<min|y>max|~datatype(x,'W')|~datatype(y,'W') then do;c=c-1;iterate;end
  324.         do b=x to y;it.c=b;c=c+1;end;c=c-1;end
  325.     else if it.c<min|it.c>max|~datatype(it.c,'W') then do;c=c-1;iterate;end;end
  326.  
  327. /* Leave the following SORT routine OUT if you plan on NEVER Sorting!     */
  328.  
  329.     if c>0 & upper(arg(4))='S' then do;do a=1 to c-1;d=a;do b=a+1 to c;d=d+1
  330.         if it.d<it.a then do;y=it.a;it.a=it.d;it.d=y;end
  331.         else if it.d=it.a then do;it.d=it.c;c=c-1;d=d-1;end;end;end;end;a=0
  332.     do i=1 to c;j=i+1;if it.i~=it.j then do;a=a+1;it.a=it.i;end;end;c=a
  333.  
  334. /* This code MUST APPEAR, whether you use the above SORT routine or NOT!  */
  335.  
  336.     do i=1 to c;it.0=it.0||it.i' ';end
  337.   return c
  338.  
  339. /**[07]*********************************************************************
  340.  *
  341.  * Description: CNet-like input routine, using MCI.
  342.  *
  343.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  344.  *
  345.  ***************************************************************************
  346.  *
  347.  *       Usage: <var>=INPUT(<text>,<length>,<MCI opt>,[default])
  348.  *
  349.  *       Where: <text>     holds the prompt text.
  350.  *              <length>   holds the max length of the input.
  351.  *              <MCI opt>  MCI input options (1=caps, 2=filename, etc.)
  352.  *                         (Review the MCI {I } Command for more info!)
  353.  *              [default]  holds the default text to appear under the
  354.  *                         cursor in the prompt.(OPTIONAL)
  355.  *
  356.  *     Returns: <var>      holds data that was input.
  357.  */
  358.  
  359. getuser 3 ; a=INPUT('n1Who are you?n1:',20,128,result)
  360. transmit 'n1answer='a ; exit
  361.  
  362. INPUT:;transmit arg(1)' L1305640 #'arg(4)'}I'arg(3)+4' 'arg(2)'}'
  363. getuser 70;return result
  364.  
  365. /**[08]*********************************************************************
  366.  *
  367.  * Description: Find and return BBSTEXT/BBSMENU line entry.
  368.  *
  369.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  370.  *
  371.  ***************************************************************************
  372.  *
  373.  *       Usage: <var>=BBSLINE(<file>,<line>)
  374.  *
  375.  *       Where: <file>    which file to use. (0=BBSMENU, 1=BBSTEXT)
  376.  *              <line>    holds the line number in BBSTEXT/BBSMENU.
  377.  *
  378.  *     Returns: <var>     holds the returned BBSTEXT/BBSMENU line entry.
  379.  */
  380.  
  381. transmit bbsline(1,4)' : line 4 in BBSTEXT'
  382. transmit bbsline(0,7)'  : line 7 in BBSMENU'
  383. exit
  384.  
  385. BBSLINE: procedure;arg ty,li;getuser 1402018+(ty*4)
  386.     ln=import(import(offset(x2c(d2x(result,8)),(li-1)*4),4),1024)
  387.     parse var ln ln'00'x .;return ln
  388.  
  389. /**[09]*********************************************************************
  390.  *
  391.  * Description: Check if a user is Suboperator in current subboard.
  392.  *
  393.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  394.  *
  395.  ***************************************************************************
  396.  *
  397.  *       Usage: <var>=SUBOP(<id>)
  398.  *
  399.  *       Where: <id>   is the ID number of the user.
  400.  *
  401.  *     Returns: <var>  holds "1" if the user has Subop access, "0" if not.
  402.  */
  403.  
  404. getuser 41;if SUBOP(result) then transmit 'Subop';else transmit 'Not Subop'
  405. exit
  406.  
  407. SUBOP: procedure;id=x2c(d2x(arg(1),8));getuser 1209388;su=result*488+96
  408.     getuser 2401068;so=import(x2c(d2x(result+su,8)),24)
  409.     do a=0 to 5;if id=substr(so,a*4+1,4) then return 1;end;return 0
  410.  
  411. /**[10]*********************************************************************
  412.  *
  413.  * Description: Checks if MCI is enabled in current subboard.
  414.  *
  415.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  416.  *
  417.  ***************************************************************************
  418.  *
  419.  *       Usage: <var>=MCIENA()
  420.  *
  421.  *     Returns: <var>  holds "1" if MCI is enabled, "0" if not.
  422.  */
  423.  
  424. if MCIENA() then transmit 'MCI enabled in this Subboard'
  425.     else transmit 'MCI disabled in this Subboard'
  426. exit
  427.  
  428. MCIENA: procedure;getuser 1209388;sub=result*488+243
  429.     getuser 2401068;return c2d(import(x2c(d2x(result+sub,8)),1))=0
  430.  
  431. /**[11]*********************************************************************
  432.  *
  433.  * Description: Convert from 12/24 hour time format to 12/24/min format.
  434.  *
  435.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  436.  *
  437.  ***************************************************************************
  438.  *
  439.  *       Usage: <var>=TIM(<value>,<mode>)
  440.  *
  441.  *       Where: <value>  is the getuser time value to convert.
  442.  *              <mode>   is the format to convert to:
  443.  *                       (12=12 Hr., 24=24 Hr., 0=Mins. Since Midnight)
  444.  *
  445.  *     Returns: <var>   holds the converted time value.
  446.  */
  447.  
  448. getuser 1500000 ; tia=result
  449. transmit 'Getuser = 'tia
  450. transmit '12 hour = 'tim(tia,12)
  451. transmit '24 hour = 'tim(tia,24)
  452. transmit 'Minutes = 'tim(tia,0)
  453. exit
  454.  
  455. TIM: procedure;parse arg ti,mo;ti=right(ti,6);select
  456.     when mo=12&verify(ti,'ap','M')~=6 then if left(ti,2)>12 then ti=' 'left(ti,2)-12||substr(ti,3,3)'p';else ti=ti'a'
  457.     when mo=24&verify(ti,'ap','M')=6 then ti=left(ti,2)+12||substr(ti,3,3)
  458.     otherwise if mo=0 then ti=(left(ti,2)+(verify(ti,'ap','M')=6)*12)*60+substr(ti,4,2)
  459.   end;return ti
  460.  
  461. /**[12]*********************************************************************
  462.  *
  463.  * Description: External Library Loader
  464.  *
  465.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  466.  *
  467.  ***************************************************************************
  468.  *
  469.  *       Usage: call LOADLIB("<library>")
  470.  *
  471.  *       Where: <library>  is the filename of the external library to load,
  472.  *                         inside of either double or single quotation marks.
  473.  *
  474.  *     Returns: If library exists, it will be loaded, but if an error occurs
  475.  *              during the load, you'll be told this and your file will
  476.  *              immediately be terminated. (This occurs if the stated library
  477.  *              is not located in your LIBS: path.)
  478.  */
  479.  
  480. options results
  481. call LOADLIB("rexxsupport.library")
  482. exit
  483.  
  484. LOADLIB: procedure ; parse arg lib ; if ~exists('libs:'lib) then do
  485.     transmit 'Error loading...'lib;bufferflush;exit;end
  486.     addlib(lib,0,-30,0) ; return
  487.  
  488. /**[13]*********************************************************************
  489.  *
  490.  * Description: View, Enable, Disable or Toggle "Priviledge" Flags.
  491.  *
  492.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  493.  *
  494.  ***************************************************************************
  495.  *
  496.  *       Usage: call PRIV(<mode>,<priv>,<name>)
  497.  *
  498.  *       Where: <mode>  is the KEYWORD (or first LETTER of KEYWORD)
  499.  *                      of the action to be performed:
  500.  *
  501.  *                      V or VIEW    - Current  Priviledge Setting.
  502.  *                      T or TOGGLE  - Reverse  Current    Setting.
  503.  *                      E or ENABLE  - Turn the Priviledge ON.
  504.  *                      D or DISABLE - Turn the Priviledge OFF.
  505.  *
  506.  *              <priv>  is the Priviledge Index Number found on the
  507.  *                      GetUser 3.1 List(The Number from 1 to 64)
  508.  *
  509.  *              <name>  is the ID Number, Handle, or Real Name of the
  510.  *                      user to perform the action on, whether they are
  511.  *                      ONLINE or NOT! (Uses CNet's Scratch Buffer!)
  512.  *
  513.  *     Returns: <priv>  holds a "Yes" if user HAS this Priviledge, or
  514.  *                              "No"  if user DOESN'T have Priviledge.
  515.  *                      (Updated AFTER Action Has Taken Place!)
  516.  *
  517.  *             <privs>  holds 64 bits of 1's and 0's where Bit 1 is the
  518.  *                      leftmost bit and Bit 64 is the rightmost bit.
  519.  *
  520.  *            <handle>  of the user action was performed on, even if
  521.  *                      you entered an ID Number as the initial argument!
  522.  *
  523.  *            <status>  will be a "1" if data saved successfully, or
  524.  *                                "0" if there was a problem saving.
  525.  *                      (Note this variable NOT used in VIEW Mode!)
  526.  */
  527.  
  528. call PRIV(View,15,Dotoran);transmit '  VIEW:  Can 'handle' Conference? 'priv
  529. call PRIV(Enable,29,David Weeks);transmit 'ENABLE:  'handle' is now a SysOp!'
  530. call PRIV(View,3,1);transmit '  VIEW:  Use RELOGON: 'priv;call PRIV(Toggle,3,1)
  531. transmit 'TOGGLE:  RELOGON command for 'handle' has been toggled.'
  532. call PRIV(View,3,1);transmit '  VIEW:  Use RELOGON: 'priv
  533. exit
  534.  
  535. PRIV: procedure expose priv privs handle status
  536.     arg mode,priv,id;b='';c=left(mode,1);if datatype(id,'n')=0 then do;findaccount id;id=result;end
  537.     if id=0 then do;transmit 'Invalid Handle! Aborted!';return;end;loadscratch id;getscratch 1;handle=result
  538.     if handle='!' then do;transmit 'Empty Account! Aborted!';savescratch (-id);return;end
  539.     do i=0 to 3;getscratch 1101332+i;a=result;b=b||reverse(c2b(d2c(a+(a<0)*256)));end i
  540.     do i=0 to 3;getscratch 1101380+i;a=result;b=b||reverse(c2b(d2c(a+(a<0)*256)));end i;privs=b
  541.     if c='E' then privs=overlay('1',privs,priv,1);if c='D' then privs=overlay('0',privs,priv,1)
  542.     if c='T' then do;a=substr('10',substr(privs,priv,1)+1,1);privs=overlay(a,privs,priv,1);end
  543.     priv=subword('No Yes',substr(privs,priv,1)+1,1);if c='V' then do;savescratch (-id);return;end
  544.     do i=0 to 3;a=c2d(b2c(reverse(substr(privs,i*8+1,8))));a=a-(a>127)*256;setobject a;putscratch 1101332+i;end i
  545.     do i=0 to 3;a=c2d(b2c(reverse(substr(privs,32+i*8+1,8))));a=a-(a>127)*256;setobject a;putscratch 1101380+i;end i
  546.     savescratch id;status=result
  547.   return
  548.  
  549. /**[14]*********************************************************************
  550.  *
  551.  * Description: Get "Arguments" from last command.
  552.  *
  553.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  554.  *              PMK             - Flux Point Amiga BBS      +45 3526-2527
  555.  *
  556.  ***************************************************************************
  557.  *
  558.  *       Usage: <var>=ARGS()
  559.  *
  560.  *       Where: <var>  is any legal variable name.
  561.  *
  562.  *     Returns: <var>    holds total number of arguments. (Max of 6)
  563.  *              <arg.0>  holds command text/name.
  564.  *              <arg.1>  holds 1st argument.
  565.  *                  |    thru
  566.  *              <arg.6>  holds 6th argument.
  567.  *
  568.  *      Note 1: Max length of any one argument is 61 characters, and any
  569.  *              unused arguments will contain the null string.
  570.  *
  571.  *      Note 2: If using CNet 2.63 thru CNet 3.04, add 1 to <var> to
  572.  *              find total number of arguments. Also, the 1st argument
  573.  *              is stored in "arg.0", 2nd in "arg.1" and so on. This
  574.  *              routine was written for CNet Amiga, v3.05!
  575.  */
  576.  
  577. total=ARGS() ; transmit 'Arguments: 'total ; transmit '  Command: 'arg.0
  578. do i=1 to total ; transmit '>4Arg 'i': 'arg.i ; end i
  579. exit
  580.  
  581. ARGS: procedure expose arg. ; getuser 1202244
  582.     do i=0 to result ; getuser 1302246+(i*61) ; arg.i=result ; end
  583.  return i-2
  584.  
  585. /**[15]*********************************************************************
  586.  *
  587.  * Description: Read "Cursor Key" / "Return/Enter" Keyboard Input.
  588.  *
  589.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  590.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  591.  *
  592.  ***************************************************************************
  593.  *
  594.  *       Usage: <var> = GETCURSOR()
  595.  *
  596.  *     Returns: <var>  will be "8" if UP    arrow was pressed.
  597.  *                     will be "2" if DOWN  arrow was pressed.
  598.  *                     will be "4" if LEFT  arrow was pressed.
  599.  *                     will be "6" if RIGHT arrow was pressed.
  600.  *                     will be "5" if ENTER or RETURN pressed.
  601.  *
  602.  *      Note 1: Returned values are identical to the numeric keypad layout,
  603.  *              so programs using this routine can be accessed by people who
  604.  *              do not have directional cursor keys (A600, C64, etc.)
  605.  *
  606.  *      Note 2: If key pressed was none of the above, then <var> will hold
  607.  *              the actual character that WAS pressed. Returned keys will be
  608.  *              UPPERCASE to mimic the same action as the GETCHAR command.
  609.  */
  610.  
  611. START:;key=GETCURSOR();transmit key;if key~='Q' then signal START;exit
  612.  
  613. GETCURSOR: procedure;do until key~='NOCHAR';maygetchar;key=result;end
  614.     if key='1B'x then do 2;maygetchar;key=result;end;else if key='D'x then return '5';else return upper(key)
  615.     if key='A' then return '8';if key='B' then return '2';if key='C' then return '6';if key='D' then return '4'
  616.   return upper(key)
  617.  
  618. /**[16]*********************************************************************
  619.  *
  620.  * Description: Convert "UPPERCASE" to "lowercase" text.
  621.  *
  622.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  623.  *              PMK             - Flux Point Amiga BBS      +45 3526-2527
  624.  *
  625.  ***************************************************************************
  626.  *
  627.  *       Usage: <var> = LOWER(<text>)
  628.  *
  629.  *       Where: <var>   is any valid variable name.
  630.  *              <text>  holds the text to be converted.
  631.  *
  632.  *     Returns: <var>   contains the converted lowercase text.
  633.  */
  634.  
  635. old="The QUICK Brown fox jumped over the LAZY log!";new=LOWER(old)
  636. transmit 'Mixed Text: 'old;transmit 'Lower Text: 'new;exit
  637.  
  638. LOWER:;return translate(ARG(1),xrange('a','z'),xrange('A','Z'))
  639.  
  640. /**[17]*********************************************************************
  641.  *
  642.  * Description: Pauses output for "x" number of seconds the RIGHT way!
  643.  *
  644.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  645.  *              PMK             - Flux Point Amiga BBS      +45 3526-2527
  646.  *
  647.  ***************************************************************************
  648.  *
  649.  *       Usage: call PAUSE(<seconds>)
  650.  *
  651.  *       Where: <seconds>  is the number of seconds to wait.
  652.  *
  653.  *        Note: This routine uses the DELAY() function, located in the
  654.  *              support library "rexxsupport.library". See the intro above
  655.  *              for more info on using this library.
  656.  */
  657.  
  658. transmit 'Print this line, now wait 5 seconds...'
  659. call PAUSE(5);transmit 'Now print this line!';exit
  660.  
  661. PAUSE:;a=delay(Arg(1)*50);return
  662.  
  663. /**[18]*********************************************************************
  664.  *
  665.  * Description: Checks for "Loss of Carrier" in your Pfiles!
  666.  *
  667.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  668.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  669.  *
  670.  ***************************************************************************
  671.  *
  672.  *     Usage 1: <var> = CHECK(<result>)
  673.  *
  674.  *     Usage 2: call CHECK
  675.  *
  676.  *       Where: <var>  is any valid variable name.
  677.  *
  678.  *      Note 1: Use [Usage 1] after you INPUT data using these commands:
  679.  *              GETCHAR, RECEIVE, PROMPT, the MCI {i }, etc.
  680.  *
  681.  *      Note 2: Use [Usage 2] to simply CHECK for CARRIER. It's a good
  682.  *              idea to use a few of these calls in places where your
  683.  *              program may be doing numerous things WITHOUT the user
  684.  *              having to enter any input.
  685.  */
  686.  
  687. getchar;a=CHECK(result);transmit a;call CHECK;transmit 'It still works';exit
  688.  
  689. CHECK:;if ARG() & ARG(1)~='###PANIC' then return ARG(1)
  690.     getcarrier;if result='TRUE' then if ARG() then return ARG(1);else return
  691.  
  692.     /* You may wish to call SAVE DATA routines here, before exiting! */
  693.  
  694.     logentry 'Lost Carrier!!';bufferflush;exit
  695.  
  696. /**[19]*********************************************************************
  697.  *
  698.  * Description: An informative "Error Checking" routine.
  699.  *
  700.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  701.  *
  702.  ***************************************************************************
  703.  *
  704.  *       Usage: To use this routine, place it somewhere near the end of
  705.  *              your program, then at the top of your program, normally
  706.  *              right after your "options results" statement, place this
  707.  *              line of text:
  708.  *
  709.  *              signal on SYNTAX ; signal on ERROR ; signal on IOERR
  710.  *
  711.  *     Returns: If an error is encountered, you will be alerted as to
  712.  *              it's nature and cause as well as being shown the name of
  713.  *              the file the error occurred in, the line number and actual
  714.  *              line the error occurred in. This same information will also
  715.  *              be noted in your "calls" log(or in "ARexx_Says"). The file
  716.  *              will then be terminated.
  717.  *
  718.  *      Note 1: Each line is formatted for 46 characters, the maximum width
  719.  *              stated on line 845 of BBSTEXT for inclusion into the logs.
  720.  *              If you include MCI/ANSI color codes into these lines, then
  721.  *              change the "%-.45s" on line 845 of BBSTEXT to read "%s".
  722.  */
  723.  
  724. signal on SYNTAX ; signal on ERROR ; signal on IOERR
  725.  
  726. average=(10+20+30+40/4     /* Causes the "Unbalanced Parenthesis" error. */
  727.  
  728. SYNTAX:;ERROR:;IOERR:;e1=' Error: 'rc' ('errortext(rc)')';e2='  Line: 'left(sigl,4)'File:'
  729.     getuser 1311992;a=result;getuser 1311960;b=result;c='"'a||b'"';e2=e2' 'c;transmit e1;transmit e2;logentry e1;logentry e2
  730.     e=sourceline(sigl);do while e~='';e3='Source: 'left(e,37);transmit e3;logentry e3;e=substr(e,38);end;bufferflush;exit
  731.  
  732. /**[20]*********************************************************************
  733.  *
  734.  * Description: Positions cursor for printing anywhere on the screen.
  735.  *
  736.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  737.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  738.  *
  739.  ***************************************************************************
  740.  *
  741.  *       Usage: <command> AT(<row>,<col>)"<text>"
  742.  *
  743.  *       Where: <command>  could be TRANSMIT, SENDSTRING, QUERY, etc.
  744.  *              <row>      is the row text will print on.
  745.  *              <col>      is the column text will start at.
  746.  *              <text>     is the text to be printed, within quotes.
  747.  *
  748.  *     Returns: will print given text at the given screen position.
  749.  */
  750.  
  751. transmit 'f1'
  752. transmit AT(1,1)"Will this work?"AT(10,10)"Hello World"
  753. do i=3 to 13 ; sendstring AT(i,50)"Looped Text; Iteration "i-2 ; end
  754. query AT(15,25)"Press ENTER Now..."
  755. exit
  756.  
  757. AT:;return ''arg(1)';'arg(2)'H'
  758.  
  759. /**[21]*********************************************************************
  760.  *
  761.  * Description: Horizontal Text Scroller Number 1.
  762.  *
  763.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  764.  *
  765.  ***************************************************************************
  766.  *
  767.  *       Usage: call SCROLLER(clr,ro1,co1,ro2,co2,dir,"txt")
  768.  *
  769.  *       Where: <clr>  Clear Screen First? (0=No, 1=Yes)
  770.  *              <ro1>  Row to START scrolling at.
  771.  *              <co1>  Column on "ro1" to START scrolling at.
  772.  *              <ro2>  Row to STOP scrolling at.
  773.  *              <co2>  Column on "ro2" to STOP scrolling at.
  774.  *              <dir>  Scroll Direction: 0=Left, 1=Right, 2=Alternate
  775.  *              <txt>  Text to be Scrolled, inside DOUBLE quotes.
  776.  *
  777.  *     Results: The <txt> line will be scrolled between the two columns
  778.  *              on each ROW individually, starting at "ro1" and ending
  779.  *              at "ro2". You can STOP the Scrolling prematurely by
  780.  *              pressing any key.
  781.  */
  782.  
  783. transmit 'f1cf8H'copies('*',44)'18H*61H*18H'copies('*',44)'c9'
  784. call SCROLLER(0,10,20,10,60,2,"CNet Amiga ToolKit, v2.0 by Dotoran & PMK!")
  785. exit
  786.  
  787. SCROLLER: procedure;parse arg clr,ro1,co1,ro2,co2,dir,txt;txt=copies(' ',co2-co1)||txt' ';if clr then cls
  788.     do i=ro1 to ro2;lo=1;in=1;hi=length(txt);if dir=2 then d2=(i/2=i%2);if d2=0 then do;lo=hi;hi=1;in=-1;end
  789.     do j=lo to hi by in;maygetchar;if result~='NOCHAR' then leave i;ch=substr(txt,j,co2-co1);transmit ''i';'co1'H'ch;end j;end i
  790.   return
  791.  
  792. /**[22]*********************************************************************
  793.  *
  794.  * Description: Horizontal Text Scroller Number 2.
  795.  *
  796.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  797.  *
  798.  ***************************************************************************
  799.  *
  800.  *       Usage: call SCROLL(<row>,<"txt">)
  801.  *
  802.  *       Where: <row>   is the Screen Row to be Scrolled.
  803.  *              <"txt"> is the Text  Line to be Scrolled, within quotes.
  804.  *
  805.  *      Note 1: You can use three special characters inside your text
  806.  *              string to affect the SPEED at which the text is shown:
  807.  *
  808.  *              Press ALT-1 (¹) for Fastest Speed.
  809.  *              Press ALT-2 (²) for Medium  Speed.
  810.  *              Press ALT-3 (³) for Slowest Speed.
  811.  *
  812.  *              This routine uses the DELAY() command to create the speeds,
  813.  *              which means the "rexxsupport.library" is also needed.
  814.  *
  815.  *      Note 2: The text string will be scrolled from RIGHT to LEFT,
  816.  *              starting at the right edge of the user's default Line
  817.  *              Length(40,80,etc.) You can abort the scrolling at any
  818.  *              time by pressing any key.
  819.  *
  820.  *      Note 3: An interesting alternate use for this routine is to
  821.  *              scroll the EXISTING text on the screen. To do this,
  822.  *              specify the "row" you wish to Scroll, then use "" as
  823.  *              the Text to Scroll. Nothing NEW will appear on the
  824.  *              screen, but any EXISTING characters ON that row will
  825.  *              be scrolled off the left side of the screen!
  826.  */
  827.  
  828. text='²CNet Amiga ToolKit, v2.0 by  >> PMK and Dotoran <<                        '
  829. text=text||'³³³³³³³³¹ This is a test of the SCROLL subroutine'
  830. call SCROLL(15,text);exit
  831.  
  832. SCROLL: procedure;parse arg line,text;sp=2;getuser27;ll=result-1
  833.     do a=1 to length(text)+ll;ch=substr(text,a,1);if index('¹²³',ch)>0 then sp=translate(ch,'246','¹²³')
  834.     else sendstring ''line';0HP'line';'ll'H'ch;call delay(sp);maygetchar;if result~='NOCHAR' then leave;end
  835.   return
  836.  
  837. /**[23]*********************************************************************
  838.  *
  839.  * Description: Read the joystick(s) and firebutton(s).
  840.  *
  841.  *   Author(s): Thomas          - Dreamline Amiga BBS       +45 3582-7043
  842.  *              PMK             - Flux Point Amiga BBS      +45 3526-2527
  843.  *
  844.  ***************************************************************************
  845.  *
  846.  *       Usage: <var>=JOY(<joynum>)
  847.  *
  848.  *       Where: <joynum>  is the Joy port (0=Port1, 1=Port2)
  849.  *
  850.  *     Returns: <var>     holds keypad values for directions, "0" if none.
  851.  *                        and value+10 if the firebutton was pressed.
  852.  *
  853.  *      Note 1: This routine will allow the joystick(s) to be used from the
  854.  *              LOCAL port only. It will NOT function from remote.
  855.  *
  856.  *      Note 2: Press your ENTER/RETURN key to exit the example given below.
  857.  */
  858.  
  859. do until key='0d'x ; maygetchar; key=result
  860.   transmit 'f1'JOY(1) ; end ; exit
  861.  
  862. JOY: procedure;arg w;a=import(d2c(14675978+w*2,4),2);b=~bittst(import('00BF E001'x,1),6+w)*10
  863.     return x2d(translate(c2x(b2c(bittst(a,8)bittst(a,9)bittst(a,0)bittst(a,1))),'963147','B31EC4'))+b
  864.  
  865. /**[24]*********************************************************************
  866.  *
  867.  * Description: First attempt at MOUSE capability. (95% Complete!)
  868.  *
  869.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  870.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  871.  *
  872.  ***************************************************************************
  873.  *
  874.  *       Usage: <var> = MOUSE(<row>,<col>,<length>)
  875.  *
  876.  *       Where: <var>  is any valid variable name.
  877.  *              <row>  is the ROW the button is located on.
  878.  *              <col>  is the COLUMN the button STARTS at.
  879.  *           <length>  is the LENGTH(in Columns) of this button.
  880.  *
  881.  *     Returns: <var>  will be "1" if the Mouse Button WAS pressed.
  882.  *                     will be "0" is the Mouse Button WASN'T pressed.
  883.  *
  884.  *      Note 1: This routine is lacking the ability to catch when you
  885.  *              "double-click" on a button, and will not ALWAYS catch
  886.  *              when you DO click on a button. If anyone can offer us
  887.  *              a better MOUSE() routine, please send us a copy and
  888.  *              we'll include it in the next version(with your name)!
  889.  *
  890.  *      Note 2: The following example program can also be aborted by
  891.  *              pressing any key, instead of using the mouse.
  892.  */
  893.  
  894. transmit 'f1Hz7c4  Press Me  z060Hz6cb  QUIT  z0'
  895. do until b1+b2>0;b1=MOUSE(5,5,12);b2=MOUSE(20,60,8);maygetchar
  896. if result~='NOCHAR' then do;transmit 'A Keyboard Key was pressed.';exit;end;end
  897. if b1=1 then transmit '"Press Me" was pressed.';if b2=1 then transmit '"QUIT" was pressed.'
  898. exit
  899.  
  900. MOUSE: procedure;getuser 1202140;xc=result%8+1 ; getuser 1202142;yc=(result-11)%8+1
  901.   return arg(1)=yc & xc>=arg(2) & xc<arg(2)+arg(3) & bittst(import('00BF E001'x,1),6)=0
  902.  
  903. /**[25]*********************************************************************
  904.  *
  905.  * Description: Disable or Enable the MORE? prompt, regardless of setting!
  906.  *
  907.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  908.  *
  909.  ***************************************************************************
  910.  *
  911.  *     Usage 1: call NOMORE
  912.  *
  913.  *     Usage 2: call MORE
  914.  *
  915.  *  Before Use: Add this line somewhere at the START of your file, so that
  916.  *              it will only be run ONCE:
  917.  *
  918.  *              getuser 1100454;oldmore=result
  919.  *
  920.  *   After Use: When you're ready to LEAVE your file, place this line BEFORE
  921.  *              every occurrance of the command EXIT:
  922.  *
  923.  *              setobject oldmore;putuser 1100454
  924.  *
  925.  *      Note 1: Use [Usage 1] when you wish to DISABLE the More? Prompt,
  926.  *              Use [Usage 2] when you wish to ENABLE  the More? Prompt.
  927.  *
  928.  *      Note 2: Be sure to add the above two lines to insure the user's
  929.  *              chosen More? setting is returned to it's original setting!
  930.  */
  931.  
  932. getuser 1100454;oldmore=result
  933. transmit 'With the More? Prompt disabled...'
  934. call NOMORE ; sendfile 'systext:help/mci'
  935. transmit 'Now with More? Prompt enabled...'
  936. call MORE ; sendfile 'systext:help/mci'
  937. setobject oldmore;putuser 1100454
  938. exit
  939.  
  940. NOMORE:;sendstring 'L1100454 #0}';return
  941. MORE:;sendstring 'L1100454 #1}';return
  942.  
  943. /**[26]*********************************************************************
  944.  *
  945.  * Description: Muffle ALL ports, regardless of setting!
  946.  *
  947.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  948.  *
  949.  ***************************************************************************
  950.  *
  951.  *       Usage: call MUFFLE
  952.  *
  953.  *  Before Use: Add this line somewhere at the START of your file, so that
  954.  *              it will only be run ONCE:
  955.  *
  956.  *              getuser 1101745 ; muffle=result ; call MUFFLE
  957.  *
  958.  *   After Use: When you're ready to LEAVE your file, place this line BEFORE
  959.  *              every occurrance of the command EXIT:
  960.  *
  961.  *              if muffle=0 then call MUFFLE
  962.  *
  963.  *      Note 1: Use "call MUFFLE" as a command in your file as well to give
  964.  *              the USER the option of toggling the Muffle Setting.
  965.  *
  966.  *      Note 2: Be sure to add the above two lines to insure the user's
  967.  *              chosen Muffle setting is returned to it's original setting!
  968.  */
  969.  
  970. getuser 1101745;muffle=result;bbscommand 'who';call MUFFLE
  971. bbscommand 'who';if muffle=0 then call MUFFLE ; bbscommand 'who'
  972. exit
  973.  
  974. MUFFLE:;if muffle=0 then bbscommand 'MU *';return
  975.  
  976. /**[27]*********************************************************************
  977.  *
  978.  * Description: Extended SelectFile Routine.
  979.  *
  980.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  981.  *
  982.  ***************************************************************************
  983.  *
  984.  *      Usage: var=SELFILE(<file>,<bcost>,<fcost>,<kill>)
  985.  *
  986.  *      Where: <file>   is the file to add to the Select Buffer (incl. Path)
  987.  *             <bcost>  "0" if the byte is FREE, "100" to deduct 1*bytesize
  988.  *                      "150" to deduct 1.5*bytesize etc.
  989.  *             <fcost>  "0" if the file is FREE, "1" for file price of 1
  990.  *                      "2" for file price of 2 etc.
  991.  *             <kill>   "0"=Don't Kill, "1"=Kill when downloaded,
  992.  *                      "2"=Kill when dl/unselect, "3"=Kill when unselected.
  993.  *
  994.  *    Returns: <var>    "0" If selectbuffer is full.
  995.  *                      "1" If selecting was sucessfull.
  996.  */
  997.  
  998. if SELFILE("s:startup-sequence",200,2,0) then transmit 'File added to selectbuffer'
  999. else transmit 'Sorry - your selectbuffer is full!'
  1000. exit
  1001.  
  1002. SELFILE: procedure;arg np,bco,fco,ki
  1003.     getuser 1209644;nu=result;getuser 2407246;if nu=result then return 0
  1004.     pa=left(np,max(lastpos(':',np),lastpos('/',np)))
  1005.     na=substr(np,length(pa)+1);si=word(statef(np),2)
  1006.     sh=x2c(d2x(si,8))left(na,32,'00'x)left(pa,96,'00'x)copies('00'x,7)x2c(d2x(ki,2))x2c(d2x(si*bco%100,8))x2c(d2x(fco,4))copies('00'x,6)copies('FF'x,4)
  1007.     getcarrier;if result~='TRUE' then exit;getuser 1401978
  1008.     call export(x2c(d2x(result+nu*156,8)),sh)
  1009.     setobject nu+1;putuser 1209644;return 1
  1010.  
  1011. /**[28]*********************************************************************
  1012.  *
  1013.  * Description: Add line of text to specified LOG file.
  1014.  *
  1015.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1016.  *
  1017.  ***************************************************************************
  1018.  *
  1019.  *       Usage: call LOG("<name>","<text>","[path]")
  1020.  *
  1021.  *       Where: <name>  is the NAME of the LOG file to add to.
  1022.  *              <text>  if the TEXT line to be added to the log.
  1023.  *              [path]  if present, this specifies an alternate path to
  1024.  *                      SAVE the LOG to. Defaults to "SysData:Log/"
  1025.  */
  1026.  
  1027. call LOG("test_log","As found in Sysdata:Log/ path.")
  1028. call LOG("test_log","As found in RAM: path!!","ram:")
  1029.  
  1030. sendfile 'sysdata:log/test_log'
  1031. sendfile 'ram:test_log'
  1032. exit
  1033.  
  1034. LOG: procedure;parse arg n,t,a;if Arg()=2 then a='SysData:Log/';n=a||n
  1035.   call open(f9,n,substr('wa',exists(n)+1,1));call writeln(f9,t)
  1036.   call close(f9);return
  1037.  
  1038. /**[29]*********************************************************************
  1039.  *
  1040.  * Description: Check Port Menu(s) Checkmark Status.
  1041.  *
  1042.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1043.  *              PMK             - Flux Point Amiga BBS      +45 3526-2527
  1044.  *
  1045.  ***************************************************************************
  1046.  *
  1047.  *       Usage: call PMENU(<port>,<item>)
  1048.  *
  1049.  *       Where: <port>  is the PORT to check. (Use 100 for ALL Ports).
  1050.  *              <item>  is the item to check. Although you can type as much
  1051.  *                      of the menu item text as you wish, only the first
  1052.  *                      letter matters, as shown below:
  1053.  *
  1054.  *                          's' to check "Sysop is in".
  1055.  *                          'n' to check "No new users".
  1056.  *                          'u' to check "UD base closed".
  1057.  *                          'p' to check "Pfiles closed".
  1058.  *                          'b' to check "Base closed".
  1059.  *
  1060.  *     Returns:  0  if there is NO checkmark shown.
  1061.  *               1  if there IS a  checkmark shown.
  1062.  */
  1063.  
  1064. transmit " Menu for Port: 0n1"
  1065. call PMENU(0,s) ; transmit '   SysOp is in: 'word('No Yes',result+1)
  1066. call PMENU(0,n) ; transmit '  No new users: 'word('No Yes',result+1)
  1067. call PMENU(0,u) ; transmit 'UD base closed: 'word('No Yes',result+1)
  1068. call PMENU(0,p) ; transmit ' Pfiles closed: 'word('No Yes',result+1)
  1069. call PMENU(0,b) ; transmit '   Base closed: 'word('No Yes',result+1)
  1070. exit
  1071.  
  1072. PMENU: procedure;arg p,m;m=index('SNUPB',left(m,1))-1
  1073.   getuser 2121864+(p*24);return bittst(d2c(result),m)
  1074.  
  1075. /**[30]*********************************************************************
  1076.  *
  1077.  * Description: Send Text File as CNet MAIL to specified User.
  1078.  *
  1079.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1080.  *
  1081.  ***************************************************************************
  1082.  *
  1083.  *       Usage: call MAIL([<id> | "<handle>" | "<name>"],"<subj>","<file>")
  1084.  *
  1085.  *       Where: <id>    can be the ID Number, Handle or Real Name of the
  1086.  *                      user in which you'd like to send the mail item to.
  1087.  *
  1088.  *              <subj>  is the Subject to name the Mail Message.
  1089.  *
  1090.  *              <file>  if the path/filename of the text file to send.
  1091.  *
  1092.  *     Returns:  0  if mail send FAILED. (File Not Found/Box Closed or Full)
  1093.  *               1  if mail was sent successfully.
  1094.  */
  1095.  
  1096. if MAIL(1,"Last 10","gfiles:Last10") then transmit "Mailed successfully!"
  1097.     else transmit "Mail send failed!"
  1098. exit
  1099.  
  1100. MAIL: procedure;parse arg id,subj,file;findaccount id'!';id=result
  1101.     if ~exists(file) then do;transmit 'File not found!';return 0;end
  1102.     loadeditor file;setmailsubj subj;writemail id;return result
  1103.  
  1104. /**[31]*********************************************************************
  1105.  *
  1106.  * Description: Send SystemOLM to current user.
  1107.  *
  1108.  *   Author(s): Bill Beogelein      - Amiga SWHQ            +1 810/473-2020
  1109.  *              PMK                 - Flux Point Amiga BBS  +45 3526-2527
  1110.  *              Dotoran             - Frontiers BBS         +1 716/823-9892
  1111.  *
  1112.  ***************************************************************************
  1113.  *
  1114.  *      Usage: call SYSOLM(<msg>)
  1115.  *
  1116.  *      Where: <msg>  is the Message to appear as a "System OLM".
  1117.  *
  1118.  *       Note: If you wish to add MCI-Commands into your OLM-text, then you
  1119.  *             need to DROP the \a1 and \@1 from the END of line number 920
  1120.  *             of your BBSTEXT file, so it reads:
  1121.  *
  1122.  *             920:   \n1\c7**** System Message\n1
  1123.  *
  1124.  *             Remember, the \'s are really CONTROL-Y's.
  1125.  */
  1126.  
  1127. call SYSOLM('This is a Test-OLM!!')
  1128. exit
  1129.  
  1130. SYSOLM: procedure;getuser 23;po=result;getuser 2307346;op=result'_olm'po
  1131.     if exists(op) then m='A';else m='W';if open(f,op,m) then do
  1132.     call writech(f,copies('00'x,30)'01'x||copies('00'x,23)arg(1)||'0a1a0a'x)
  1133.     call close(f);sendstring 'M1101743 #1 + +}';end;return
  1134.  
  1135. /**[32]*********************************************************************
  1136.  *
  1137.  * Description: Add keystrokes to other ports from present port.
  1138.  *
  1139.  *   Author(s): Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1140.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1141.  *
  1142.  ***************************************************************************
  1143.  *
  1144.  *       Usage: call ADDEM(<port>,"<keys>",<mode>)
  1145.  *
  1146.  *       Where: <port>  is the port number to add keystrokes too.
  1147.  *              <keys>  are the keystrokes to add, within double quotes.
  1148.  *              <mode>  as '1' and the user will see them,
  1149.  *                      as '2' and the user will NOT see them.
  1150.  *
  1151.  *     Returns: Keystrokes will be entered into the command stream on stated
  1152.  *              port. Nothing will be returned on your port.
  1153.  *
  1154.  *     Example: call ADDEM(2,"o!",2) will logoff user on port 2 without them
  1155.  *                                   knowing what just happened!
  1156.  */
  1157.  
  1158. query '  Send to which port? ';port=result
  1159. query 'Add which keystrokes? ';keys=result
  1160. sendstring ' Disable serial port? ';getchar;a=result
  1161. if a='Y' then mode=2;else mode=1;transmit word('No Yes',mode)
  1162.  
  1163. call ADDEM(port,keys,mode)
  1164. exit
  1165.  
  1166. ADDEM: procedure;parse arg po,ke,mo;address ('CNETREXX'po)
  1167.   modem mo;addkeys ke'`';modem 1;return
  1168.  
  1169. /**[33]*********************************************************************
  1170.  *
  1171.  * Description: A QUICK "Who" for SysOps, listing Access Group Number.
  1172.  *
  1173.  *   Author(s): Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1174.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1175.  *
  1176.  ***************************************************************************
  1177.  *
  1178.  *       Usage: call WHO
  1179.  *
  1180.  *     Returns: Displays all loaded ports, listing port number, handle,
  1181.  *              access group, speed, from and where info.
  1182.  */
  1183.  
  1184. call WHO
  1185. exit
  1186.  
  1187. WHO: procedure;transmit 'r1#  'left('Handle',21)left('AG SPD From',38)left('Location',16)'r0';getuser 2225094
  1188.     hp=result;do po=0 to hp;getportid po;pi=result;if pi=-1 then iterate;loadscratch pi;savescratch (-pi)
  1189.     getscratch 1;ha=result;getscratch 15;ac=result;getwhere po;wh=result;getscratch 1201214;cp=result%10
  1190.     getscratch 4;fr=result;transmit left(po,3)left(ha,21)left(ac,3)left(cp,4)left(fr,31)left(wh,16);end;return
  1191.  
  1192. /**[34]*********************************************************************
  1193.  *
  1194.  * Description: View "port" log of specified port. (Pre "calls" log).
  1195.  *
  1196.  *   Author(s): Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1197.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1198.  *
  1199.  ***************************************************************************
  1200.  *
  1201.  *       Usage: call LOGPO(<port>)
  1202.  *
  1203.  *       Where: <port>  is the port number to view the log of.
  1204.  *
  1205.  *     Returns: Displays the "calls" log entry for this user, as it looks
  1206.  *              so far. By activating other log processes through CONFIG
  1207.  *              without assigning other log names for them, you can see
  1208.  *              what the user has done up to that point this call.
  1209.  */
  1210.  
  1211. query 'Port to view log of? ';po=result;call LOGPO(po);exit
  1212.  
  1213. LOGPO: procedure;arg p;if exists('sysdata:log/port'p) then sendfile 'sysdata:log/port'p
  1214.   else transmit 'Port 'p' log not found.';return
  1215.  
  1216. /**[35]*********************************************************************
  1217.  *
  1218.  * Description: Send Line Noise to a port (Ability to kick them off too!)
  1219.  *
  1220.  *   Author(s): Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1221.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1222.  *
  1223.  ***************************************************************************
  1224.  *
  1225.  *       Usage: call LNOISE(<port>,<drop>)
  1226.  *
  1227.  *       Where: <port>  is the port number to send Line Noise to.
  1228.  *              <drop>  as '1' will also DROP CARRIER on that port,
  1229.  *                      as '0' will NOT drop carrier. Just Annoy! hehe
  1230.  *
  1231.  *     Returns: A check is done to make sure that the user using this routine
  1232.  *              is a Conference Controller and that the port number entered
  1233.  *              is a valid number. A check is also done to make sure the
  1234.  *              user issuing the Line Noise doesn't lose carrier themselves.
  1235.  */
  1236.  
  1237. query 'Send Line Noise to which Port? ';port=result
  1238. sendstring 'Should  it  also Drop Carrier? ';getchar;a=result
  1239. if a='Y' then drop=1;else drop=0;transmit word('No Yes',drop+1)
  1240. call LNOISE(port,drop)
  1241. exit
  1242.  
  1243. LNOISE: procedure;arg p,d;a=time('s');getuser 1100661;c=result;if bittst(d2c(c+(c<0)*256),7)=0 then exit
  1244.     if p='###PANIC' then exit;getuser 2225094;hp=result;if p>hp|p<0|datatype(p,'n')=0 then exit
  1245.     a.0='s1ou‡†797¾’s0†7’†™i7';a.1='‰¾';a.2='«¾’†«¾’y‰”’†«¾”®«¾7r';a.3='®6¾½¤80y9ohj; ;'
  1246.     a.4=':OJl•Š;;ø·';a.5=' ¡¾½¼©w1µþð65™…®ð7';a.6='54®©       †„7    08o  7pi‹­·¡'
  1247.     a.7='¾µ¤ˆP*o¡¤þ·ž7ue64s¼¢³ž”…G';a.8='DXc  . LJ. Š;o8';a.9='n ¡¾½#©ð™”¢’e';a.10='¾ž¼43…5i6yYth98h¤«‰yˆ)*Ou9i76y'
  1248.     a.11='¡¾½f«¾s1¼®®«¾5»·y9i-»«•s0098þ·žr·ž«¾†‰«¾‰”«¾¡';a.12='utg97‰•”‡97”•‹n1‰¾þ‰•'
  1249.     a.13='T«¡¾þ®†Š™hgb¸–ºmnª­º vh,v­bvÇn';a.14=' c ‚Vƒ˜‚šxgedy';a.15='trd¡¤‹†w1ˆ¡µðµþðç        dd'
  1250.     a.16='½þµð•n1þµð•”„';a.17='¤þ¡µðiy‰™†ð';a.18='uy';address ('CNETREXX'p)
  1251.     do for random(4,18);l=random(0,18);sendstring a.l;end;if d=1 then dropcarrier
  1252.     do for random(4,18);l=random(0,18);sendstring a.l;end;bufferflush;return
  1253.  
  1254. /**[36]*********************************************************************
  1255.  *
  1256.  * Description: UnLock User Accounts (That May NOT Have Been Previously!)
  1257.  *
  1258.  *   Author(s): Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1259.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1260.  *
  1261.  ***************************************************************************
  1262.  *
  1263.  *       Usage: call UNLOCK(< id | handle | name >)
  1264.  *
  1265.  *       Where: <id>  is the ID number of the account to UnLock. This can
  1266.  *                    also be specified as the Handle or Real Name of the
  1267.  *                    user whose account you wish unlocked. Use "0" to
  1268.  *                    UnLock ALL accounts on your system.
  1269.  *
  1270.  *     Returns: Will tell you when it's done.
  1271.  *
  1272.  *        Note: You should only run this file when there are NO OTHER ARexx
  1273.  *              tasks running simultaneously, as if one of these other tasks
  1274.  *              were to LOCK an account, Unlocking it prematurely may cause
  1275.  *              THAT task to fail or crash. This routine is meant as a FIX
  1276.  *              for any files using LOADSCRATCH where you believe there to
  1277.  *              be a problem with it not UNLOCKING the accounts.
  1278.  */
  1279.  
  1280. query 'Account to UnLock? [0=ALL]: ';p=result
  1281. call UNLOCK(p);exit
  1282.  
  1283. UNLOCK: procedure;arg p;getuser 2400088;ta=result;if p=0 then do i=1 to ta;savescratch (-i);sendstring '.';end i
  1284.   else do;findaccount p;id=result;savescratch (-id);end;transmit 'Account(s) unlocked.';return
  1285.  
  1286. /**[37]*********************************************************************
  1287.  *
  1288.  * Description: Replace <input> with <output> within string of <text>.
  1289.  *              (A bit like the AREXX's TRANSLATE command, but NOT limited
  1290.  *               to replacing text of equal length)
  1291.  *
  1292.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  1293.  *
  1294.  ***************************************************************************
  1295.  *
  1296.  *       Usage: <var>=REPLACE(<text>,<input>,<output>)
  1297.  *
  1298.  *       Where: <text>    holds the text to do replacement on.
  1299.  *              <input>   is the text you want to replace.
  1300.  *              <output>  is the text you want to appear instead of <input>
  1301.  *
  1302.  *     Returns: <var>     holds the replaced <text>.
  1303.  */
  1304.  
  1305. text='My handle is PMK, and this is a test!! - PMK!!'
  1306. transmit 'n1Before replace: 'text ; getuser 1 ; handle=result
  1307. transmit 'n1 After replace: 'REPLACE(text,'PMK',handle)
  1308. exit
  1309.  
  1310. REPLACE: procedure;parse arg a,b,c;d=index(a,b);do while d~=0
  1311.   a=insert(c,delstr(a,d,length(b)),d-1);d=index(a,b);end;return a
  1312.  
  1313. /**[38]*********************************************************************
  1314.  *
  1315.  * Description: Find and return BBSMENU Line(s).
  1316.  *
  1317.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  1318.  *
  1319.  ***************************************************************************
  1320.  *
  1321.  *       Usage: <var>=BMTXT(<menu>,[<line>])
  1322.  *
  1323.  *       Where: <menu>  BBSMENU Menu Number.
  1324.  *              <line>  Line Number in Menu.
  1325.  *
  1326.  *     Returns: <var>   holds the returned BBSMENU Menu Line entry, if the
  1327.  *                      <line> option was used, or else the number of lines
  1328.  *                      in that BBSMENU Menu, while the "BMT.<x>" array will
  1329.  *                      hold the BBSMENU listing.
  1330.  */
  1331.  
  1332. transmit 'Menu #  7, Item 6: 'BMTXT(7,6)
  1333. transmit 'Menu # 12, Item 3: 'BMTXT(12,3)
  1334. transmit 'Menu # 30, Item 8: 'BMTXT(30,8)
  1335. transmit 'n1Complete Menu # 2: n1'
  1336. do d=0 to BMTXT(2);transmit right(d,2)') 'bmt.d;end d;exit
  1337.  
  1338. BMTXT: procedure expose bmt.;b=ARG(1)*2;getuser 2401064;t=import(x2c(d2x(result,8)),220)
  1339.   parse var t 13 p +4 =b+21 s +2 =b+121 l +2;if ARG()=2&(ARG(2)<=c2d(l)) then do
  1340.   m=import(import(offset(p,4*(c2d(s)+ARG(2))),4),512);parse var m t'00'x;return translate(t,'\{','');end
  1341.   c=0;do a=c2d(s) to (c2d(s)+c2d(l)-1);m=import(import(offset(p,4*a),4),512);parse var m t'00'x;bmt.c=translate(t,'\{','');c=c+1;end;return c-1
  1342.  
  1343. /**[39]*********************************************************************
  1344.  *
  1345.  * Description: Clears a specific port, by dumping the user. Similar to
  1346.  *              the DROPCARRIER command, but allows different log entries.
  1347.  *
  1348.  *   Author(s): PMK             - Flux Point Amiga BBS      +45 3526-2527
  1349.  *
  1350.  ***************************************************************************
  1351.  *
  1352.  *       Usage: call DUMPUSER(<port>,<logoff>,[<quick>])
  1353.  *
  1354.  *       Where: <port>    is the port number to clear. (dumps user)
  1355.  *              <logoff>  as  '0' shows 'TIME LIMIT EXCEEDED' in the log.
  1356.  *                        as  '1' shows 'AUTO CALL-BACK FAILED' in the log.
  1357.  *                        as  '2' shows 'IDLE TIME EXCEEDED' in the log.
  1358.  *                        as  '3' shows 'LOST CARRIER' in the log.
  1359.  *                        as  '4' shows 'INSTANT LOGOFF' in the log.
  1360.  *                        as  '5' shows 'NORMAL LOGOFF' in the log.
  1361.  *                        as  '6' shows 'RE-LOGON' in the log.
  1362.  *                        as  '7' shows '$ BALANCE TOO LOW' in the log.
  1363.  *                        as  '8' shows 'DUMPED BY SYSOP' in the log.
  1364.  *                        as  '9' shows 'FILE XFER AUTO-LOGOFF' in the log.
  1365.  *                        as '10' shows 'MCI % COMMAND' in the log.
  1366.  *                        as '11' shows 'TERM LINK' in the log.
  1367.  *              <quick>   if '1', a quick logoff is performed. (similar to
  1368.  *                        the normal 'O!' - No SYS.END is displayed.)
  1369.  *
  1370.  *              A check is done to make sure that the port number entered
  1371.  *              is a valid number, and the port is occupied by a user.
  1372.  *
  1373.  *     Returns: '0' if the dumping failed (no user on port, bad port etc.)
  1374.  *              '1' if the user was successfully dumped.
  1375.  */
  1376.  
  1377. call dumpuser(0,3)
  1378. exit
  1379.  
  1380. DUMPUSER:procedure;arg p,d,q;if q~=1 then q=0
  1381.   getportid p;if result=-1|~datatype(p,'W')|~datatype(d,'W')|d<0|d>11 then return 0
  1382.   address ('CNETREXX'p);sendstring 'L1109799 #'q'}L1200022 #'d'}L1109807 #1}';addkeys '`';return 1
  1383.  
  1384.  
  1385. /**[40]*********************************************************************
  1386.  *
  1387.  * Description: EnCode & DeCode text strings, using a Numeric Key. Given the
  1388.  *              desired text string, along with a numeric key, the text will
  1389.  *              be encoded using a specific code string. The text can then
  1390.  *              only be decoded using the same numeric key.
  1391.  *
  1392.  *   Author(s): Dotoran         - Frontiers BBS             +716 823-9892
  1393.  *
  1394.  ***************************************************************************
  1395.  *
  1396.  *       Usage: To EnCode a text string, use the ENCODE() function:
  1397.  *
  1398.  *              <var> = ENCODE( <text> , <key> )
  1399.  *
  1400.  *       Where: <var>  is the variable the encoded text will be placed.
  1401.  *              <text> is the text string(or variable holding text string)
  1402.  *                     that needs to be encoded.
  1403.  *              <key>  is a numeric value between 1 and 94. Values below 1
  1404.  *                     or greater than 94 will return INCORRECT results!
  1405.  *
  1406.  *       Usage: To DeCode a coded text string, use the DECODE() function:
  1407.  *
  1408.  *              <var> = DECODE( <text> , <key> )
  1409.  *
  1410.  *       Where: <var>  is the variable the decoded text will be stored in.
  1411.  *              <text> is the ALREADY CODED text string you wish to DeCode.
  1412.  *                     This can also be a variable containing coded text.
  1413.  *              <key>  is the SAME numeric key you used to MAKE the initial
  1414.  *                     coded string. If you do NOT use the SAME numeric key,
  1415.  *                     then the text will NOT be DeCoded correctly.
  1416.  *
  1417.  *       Notes: This technique comes in real handy when you wish to encrypt
  1418.  *              data before saving it to disk. The data can then be decoded
  1419.  *              as it is read in the next time it is needed.
  1420.  */
  1421.  
  1422. query "   Enter the text to Encode: ";a=result
  1423. query "Key value(between 1 and 94): ";k=result
  1424. y=ENCODE(a,k);z=DECODE(y,k);transmit
  1425. transmit "Entered Text: "a
  1426. transmit "EnCoded Text: "y
  1427. transmit "DeCoded Text: "z
  1428. exit
  1429.  
  1430. ENCODE:procedure;parse arg t,k;a=xrange(" ","~")
  1431.   k=xrange(d2c(32+k),"~")xrange(" ",d2c(31+k));return translate(t,a,k)
  1432. DECODE:procedure;parse arg t,k;a=xrange(" ","~")
  1433.   k=xrange(d2c(32+k),"~")xrange(" ",d2c(31+k));return translate(t,k,a)
  1434.  
  1435. ****************************************************************************
  1436. Contributing Authors:
  1437.  
  1438.         PMK                     - Flux Point Amiga BBS      +45 3526-2527
  1439.         Dotoran                 - Frontiers BBS             +1 716/823-9892
  1440.         Aunt Bea                - Blue Moon BBS             +1 716/871-9866
  1441.         Thomas                  - Dreamline Amiga BBS       +45 3582-7043
  1442.         Bill Beogelein          - Amiga SWHQ                +1 810/473-2020
  1443.